The goal of study 3 was to…
library(tidyverse)
library(ggdist)
library(ggside)
library(easystats)
library(patchwork)
library(brms)
source("../study2/functions.R")
# Variables
DVs <- c("Delboeuf" = "#2196F3",
"Ebbinghaus" = "#3F51B5",
"RodFrame" = "#F44336",
"VerticalHorizontal" = "#FF5722",
"Zollner" = "#FF9800",
"White" = "#9E9E9E",
"MullerLyer" = "#4CAF50",
"Ponzo" = "#009688",
"Poggendorff" = "#795548",
"Contrast" = "#607D8B",
"I" = "#9C27B0")
# Load data
dfsub <- read.csv("../data/study3.csv") |>
mutate(
Screen_Refresh = as.numeric(Screen_Refresh),
Education = fct_relevel(Education, "High School", "Bachelor", "Master", "Doctorate", "Other", "Prefer not to Say")
) |>
datawizard::standardise(select=names(DVs)) |>
datawizard::change_scale(select=starts_with("IPIP"), to = c(0, 1), range = c(0, 100)) |>
datawizard::change_scale(select=starts_with("PID"), to = c(0, 1), range = c(0, 100))
# Remove outliers (p < 0.0001)
dfsub[names(DVs)][abs(dfsub[names(DVs)]) > qnorm(0.9999)] <- NA
dflong <- dfsub |>
pivot_longer(all_of(names(DVs)), names_to = "Index", values_to = "Score")
8 participants did not do the personality scales.
p_age <- estimate_density(dfsub$Age) |>
ggplot(aes(x = x, y = y)) +
geom_area(fill = "#607D8B") +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0)) +
labs(title = "Age", color = NULL) +
theme_modern() +
theme(
plot.title = element_text(size=rel(1), face = "bold", hjust = 0.5),
plot.subtitle = element_text(face = "italic", hjust = 0.5),
# axis.line.y = element_blank(),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.text.x = element_text(size=rel(0.6)),
axis.title.x = element_blank()
)
p_nat <- dfsub |>
group_by(Nationality) |>
summarize(n = n()) |>
mutate(Nationality = fct_reorder(Nationality, desc(n))) |>
ggplot(aes(x = Nationality, y = n, fill=Nationality)) +
geom_bar(stat = "identity") +
labs(y = "Number", title = "Nationality") +
scale_fill_material_d(guide = "none") +
scale_x_discrete(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0)) +
theme_modern() +
theme(
plot.title = element_text(size=rel(1), face = "bold", hjust = 0.5),
plot.subtitle = element_text(face = "italic", hjust = 0.5),
# axis.line.y = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
axis.text.y = element_text(size=rel(0.6)),
axis.text.x = element_text(size=rel(0.5), angle = 45, hjust=1)
)
ggsave("figures/figure_dem1.png",
patchwork::wrap_elements(p_age / p_nat),
width=0.5*(fig.height),
height=1*(fig.height), dpi=1000, bg="white")
p_sex <- plot_waffle(dfsub, what="Sex", rows = 10, size=5) +
scale_color_manual(values = c("Male" = "#2196F3", "Female" = "#E91E63"))
p_edu <- plot_waffle(dfsub, "Education", rows = 10, size=5) +
scale_color_viridis_d()
p_race <- plot_waffle(dfsub, "Ethnicity", rows = 10, size=5) +
scale_color_manual(values = c("Latino" = "#FF5722", "Caucasian" = "#2196F3", "African" = "#4CAF50", "Other" = "#795548"))
ggsave("figures/figure_dem2.png",
patchwork::wrap_elements(p_sex / p_edu / p_race), width=1*(fig.height), height=1*(fig.height), dpi=1000, bg="white")
p_ipip <- dfsub |>
select(starts_with("IPIP") & !ends_with("_SD")) |>
estimate_density() |>
mutate(Parameter = str_remove_all(Parameter, "IPIP6_"),
Parameter = str_replace(Parameter, "HonestyHumility", "Honesty-Humility")) |>
ggplot(aes(x = x, y = y, color = Parameter)) +
geom_line(size = 1) +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0)) +
scale_color_manual(values=c("Agreeableness" = "#FFC107", "Honesty-Humility" = "#00BCD4", "Extraversion" = "#9C27B0", "Conscientiousness" = "#3F51B5", "Openness" = "#4CAF50", "Neuroticism" = "#E91E63")) +
labs(x = "Score", title = "Normal Personality", color = NULL) +
theme_modern() +
theme(
plot.title = element_text(size=rel(1), face = "bold", hjust = 0.5),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.text.x = element_text(size=rel(0.6)),
axis.title.x = element_blank(),
legend.text = element_text(size=rel(0.8))
# legend.position = "top",
)
p_pid <- dfsub |>
select(starts_with("PID") & !ends_with("_SD")) |>
estimate_density() |>
mutate(Parameter = str_remove_all(Parameter, "PID5_"),
Parameter = str_replace(Parameter, "NegativeAffect", "Negative Affect")) |>
ggplot(aes(x = x, y = y, color = Parameter)) +
geom_line(size = 1) +
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(expand = c(0, 0)) +
scale_color_manual(values=c("Antagonism" = "#FF9800", "Detachment" = "#03A9F4", "Disinhibition" = "#FF5722", "Negative Affect" = "#F44336", "Psychoticism" = "#673AB7")) +
labs(x = "Score", title = "Pathological Personality", color = NULL) +
theme_modern() +
theme(
plot.title = element_text(size=rel(1), face = "bold", hjust = 0.5),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.text.x = element_text(size=rel(0.6)),
axis.title.x = element_blank(),
legend.text = element_text(size=rel(0.8))
# legend.position = "top",
)
ggsave("figures/figure_dem3.png",
patchwork::wrap_elements(p_ipip / p_pid), width=2/3*(fig.height), height=1*(fig.height), dpi=1000, bg="white")
p_dem <- (
patchwork::wrap_elements(grid::rasterGrob(png::readPNG("figures/figure_dem1.png"), interpolate = TRUE)) |
patchwork::wrap_elements(grid::rasterGrob(png::readPNG("figures/figure_dem2.png"), interpolate = TRUE)) |
patchwork::wrap_elements(grid::rasterGrob(png::readPNG("figures/figure_dem3.png"), interpolate = TRUE))
) +
patchwork::plot_layout(widths=c(1/2, 1, 2/3)) +
patchwork::plot_annotation(title = "Participants (n = 250)",
theme = theme(plot.title = element_text(size = rel(1.5), face="bold", hjust=0.5, vjust=-5)))
ggsave("figures/figure_dem.png", p_dem, dpi=1000)
## Saving 11.3 x 7 in image
p_dem
preds <- data.frame()
for(i in names(DVs)) {
# model <- brms::brm(paste0(i, " ~ s(Screen_Size)"), data=dfsub, algorithm = "meanfield", refresh=0)
# param <- bayestestR::describe_posterior(as.data.frame(model))
model <- lm(as.formula(paste0(i, " ~ Screen_Size")),
data=dfsub)
param <- parameters::parameters(model)
pred <- estimate_relation(model, length=50)
pred$Index <- i
pred$sig <- param$p[2]
preds <- rbind(preds, pred)
if(any(pred$sig < .05)) {
print(i)
}
}
## [1] "White"
## [1] "Contrast"
preds |>
mutate(sig = format_p(sig, stars_only = TRUE),
sig = ifelse(sig == "", "NS", sig)) |>
ggplot(aes(x = Screen_Size, y = Predicted)) +
geom_point2(data=dflong, aes(y = Score, color= Index), alpha=0.1, size=2) +
geom_line(aes(color = Index, group = Index, linetype = sig, size = sig)) +
scale_x_continuous(expand = c(0, 0)) +
scale_size_manual(values = c("NS" = 0.5, "*" = 1)) +
scale_linetype_manual(values = c("NS" = "dotted", "*" = "solid")) +
scale_color_manual(values = DVs) +
coord_cartesian(ylim = c(-2.5, 2.5)) +
theme_modern() +
labs(y = "Illusion Sensitivity", x = "Screen Size", linetype="Significance", size="Significance") +
ggside::geom_xsidedensity(data=dfsub, fill ="grey", color = "white") +
ggside::geom_ysidedensity(data=dflong, aes(y=Score, color = Index)) +
ggside::theme_ggside_void() +
ggside::scale_ysidex_continuous(expand = c(0, 0)) +
ggside::scale_xsidey_continuous(expand = c(0, 0))
preds <- data.frame()
for(i in names(DVs)) {
# model <- brms::brm(paste0(i, " ~ s(Screen_Refresh)"), data=dfsub, algorithm = "meanfield", refresh=0)
# param <- bayestestR::describe_posterior(as.data.frame(model))
model <- lm(as.formula(paste0(i, " ~ Screen_Refresh")),
data=dfsub)
param <- parameters::parameters(model)
pred <- estimate_relation(model, length=50)
pred$Index <- i
pred$sig <- param$p[2]
preds <- rbind(preds, pred)
if(any(pred$sig < .05)) {
print(i)
}
}
preds |>
mutate(sig = format_p(sig, stars_only = TRUE),
sig = ifelse(sig == "", "NS", sig)) |>
ggplot(aes(x = Screen_Refresh, y = Predicted)) +
geom_point2(data=dflong, aes(y = Score, color= Index), alpha=0.1, size=2) +
geom_line(aes(color = Index, group = Index, linetype = sig, size = sig)) +
scale_x_continuous(expand = c(0, 0)) +
scale_size_manual(values = c("NS" = 0.5, "*" = 1)) +
scale_linetype_manual(values = c("NS" = "dotted", "*" = "solid")) +
scale_color_manual(values = DVs) +
coord_cartesian(ylim = c(-2.5, 2.5)) +
theme_modern() +
labs(y = "Illusion Sensitivity", x = "Screen Refresh Rate", linetype="Significance", size="Significance") +
ggside::geom_xsidedensity(data=dfsub, fill ="grey", color = "white") +
ggside::geom_ysidedensity(data=dflong, aes(y=Score, color = Index)) +
ggside::theme_ggside_void() +
ggside::scale_ysidex_continuous(expand = c(0, 0)) +
ggside::scale_xsidey_continuous(expand = c(0, 0))
sig <- list()
params <- data.frame()
for(i in names(DVs)) {
model <- lm(paste0(i, " ~ Sex"), data=dfsub)
param <- parameters::parameters(model)
param$Index <- i
param$ymiddle <- param$Coefficient[1] + diff(param$Coefficient) / 2
param$BF <- parameters::parameters(BayesFactor::ttestBF(formula=as.formula(paste0(i, " ~ Sex")), data=dfsub[!is.na(dfsub[[i]]), ]))$BF
params <- rbind(params, as.data.frame(param[2, ]))
}
data <- dfsub |>
pivot_longer(all_of(names(DVs)), names_to = "Index", values_to = "Score") |>
mutate(Index = fct_relevel(Index, names(DVs)),
Index = fct_relabel(Index, ~prettify_itemName(.x))) # arrange(params, p)$Index
p_gender <- data |>
ggplot(aes(x = Index, y = Score)) +
stat_slab(data=filter(data, Sex == "Male"), aes(fill = Sex), side = "left", scale = 0.5, position = "dodge") +
stat_slab(data=filter(data, Sex == "Female"), aes(fill = Sex), side = "right", scale = 0.5, position = "dodge") +
stat_pointinterval(aes(group = fct_rev(Sex)), point_interval = "mean_qi", position = "dodge") +
geom_text(data = mutate(params, sig = insight::format_p(p, stars_only = TRUE), Index = prettify_itemName(Index)), aes(label = sig, y = ymiddle)) +
geom_label(data = mutate(params, label = insight::format_bf(BF), Index = prettify_itemName(Index)),
aes(label = label), y=2.7) +
scale_fill_manual(values = c("Male" = "#2196F3", "Female" = "#E91E63")) +
theme_minimal() +
labs(title = "Illusion Sensitivity Scores", fill = "") +
theme(legend.position = "top",
axis.title = element_blank(),
plot.title = element_text(face = "bold", hjust=0.5))
p_gender
ggsave("figures/figure_sex.png", p_gender, width=2*(fig.height), height=0.8*(fig.height), dpi=600, bg="white")